home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / multgrid / module1.bas < prev   
BASIC Source File  |  1998-08-22  |  3KB  |  96 lines
  1. Attribute VB_Name = "Module1"
  2. Public Sub GridMultiSelect _
  3. (Button As Integer, Shift As Integer, X As Single, Y As Single, ThisGrid As DBGrid, ThisRS As Recordset)
  4.     
  5. 'Sub written by Gary Thibault
  6. 'If you have any improvements or commments then please contact me
  7. 'at gwtbolt@frontiernet.net
  8.  
  9. 'Create a mouse down event for the grid you want to apply this sub to.
  10. 'Your mouse down event should look like this:
  11. 'Private Sub DBgrid_MouseDown _
  12. '(Button As Integer, Shift As Integer, X As Single, Y As Single)
  13. 'DBgrid should be changed to the name of your DBgrid
  14.  
  15. 'Next, call the sub. The call should look like this
  16. 'Call GridMultiSelect(Button, Shift, X, Y, DBgrid, Datcontrol.Recordset)
  17. 'All you have to do to the above call is change DBgrid to the name of your grid and
  18. 'change DatControl to the name of your Datcontrol. Everthing else stays the same
  19.     
  20.     'X = Col position and Y = Row Position
  21. Dim LeftButtonClicked As Boolean
  22. Dim ShiftButtonPressed As Boolean
  23. Dim OverRowSelector As Boolean
  24. Dim SelFirst As Integer
  25. Dim SelLast As Integer
  26. Dim BeginRow As Integer
  27. Dim EndRow As Integer
  28. Dim Bmk As Variant
  29. Dim Row As Integer
  30. Dim SelLastGridRow As Single
  31.  
  32.     'returns true if Left mouse button is clicked
  33. LeftButtonClicked = (Button = vbLeftButton)
  34.     'returns true if shift button is held down
  35. ShiftButtonPressed = (Shift = vbShiftMask)
  36.     'returns true only if a row selecter is clicked,
  37.     'remove this if you want the user to be able to click
  38.     'anywhere in the row to select that row.
  39. OverRowSelector = (ThisGrid.ColContaining(X) = -1)
  40.     'Clicked over row selector with shift button pressed and
  41.     'one row previously selected as your starting row.
  42.     'Also makes sure user did not select previously selected row
  43. If LeftButtonClicked And OverRowSelector And ShiftButtonPressed _
  44. And ThisGrid.SelBookmarks.Count = 1 And _
  45. ThisGrid.Row <> ThisGrid.RowContaining(Y) Then
  46.  
  47.     'get the relative record number for the first record
  48. SelFirst = ThisRS.AbsolutePosition
  49.     'get the bookmark for the next item selected in the grid
  50. Bmk = ThisGrid.RowBookmark(ThisGrid.RowContaining(Y))
  51.     'move the current record to the next item selected because
  52.     'the current record did not change while shift key was pressed
  53. ThisRS.Bookmark = Bmk
  54.     'get the relative record number for the last record
  55. SelLast = ThisRS.AbsolutePosition
  56.     'record the *grids* row number for the last item selected
  57. SelLastGridRow = ThisGrid.Row
  58.  
  59.  
  60.  On Error GoTo ErrorHandler
  61.         'make sure that we are looping from low to high
  62.     If SelFirst < SelLast Then
  63.         BeginRow = SelFirst
  64.         EndRow = SelLast
  65.     Else
  66.         BeginRow = SelLast
  67.         EndRow = SelFirst
  68.     End If
  69.         
  70.     
  71.         'add all the bookmarks to the selbookmark collection
  72.     For Row = BeginRow To EndRow
  73.         ThisRS.AbsolutePosition = Row
  74.         Bmk = ThisRS.Bookmark
  75.         ThisGrid.SelBookmarks.Add Bmk
  76.     Next Row
  77.         'Return display to original viewing position while
  78.         'moving selector to record clicked with shift key
  79.     
  80.     
  81.     If ThisGrid.RowBookmark(ThisGrid.Row) = ThisGrid.FirstRow Then
  82.         ThisRS.AbsolutePosition = SelLast
  83.             'converts the positive into a negative
  84.         SelLastGridRow = (SelLastGridRow - (SelLastGridRow * 2))
  85.         ThisGrid.Scroll 0, SelLastGridRow
  86.     End If
  87.     
  88. End If
  89. Exit Sub
  90. 'why crash?
  91. ErrorHandler:
  92. MsgBox Err.Number & " " & Err.Description
  93. End Sub
  94.  
  95.  
  96.